home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / elib-006.lha / elib-0.06 / library / bintree.el < prev    next >
Lisp/Scheme  |  1993-01-24  |  10KB  |  344 lines
  1. ;;;; $Id: bintree.el,v 0.5 1992/08/19 01:57:32 ceder Exp $
  2. ;;;; This file implements binary trees.
  3. ;;;;
  4. ;;;; Copyright (C) 1991, 1992 Free Software Foundation
  5. ;;;;
  6. ;;;; This file is part of the GNU Emacs lisp library, Elib.
  7. ;;;;
  8. ;;;; GNU Elib is free software; you can redistribute it and/or modify
  9. ;;;; it under the terms of the GNU General Public License as published by
  10. ;;;; the Free Software Foundation; either version 1, or (at your option)
  11. ;;;; any later version.
  12. ;;;;
  13. ;;;; GNU Elib is distributed in the hope that it will be useful,
  14. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;;;; GNU General Public License for more details.
  17. ;;;;
  18. ;;;; You should have received a copy of the GNU General Public License
  19. ;;;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21. ;;;;
  22. ;;;; Author:  Inge Wallin
  23. ;;;;
  24.  
  25.  
  26. ;;;
  27. ;;; A binary tree consists of two cons cells, the first one holding
  28. ;;; the tag 'BINTREE in the car cell and the second one having
  29. ;;; the tree in the car and the compare function in the cdr cell. The
  30. ;;; tree has a dummy node as its root with the real tree in the left
  31. ;;; pointer.  The compare function must take two arguments of the type
  32. ;;; which is to be stored in the tree and must return non-nil if
  33. ;;; the first argument is "less than" the second argument and nil 
  34. ;;; otherwise.
  35. ;;;
  36. ;;; For example, use
  37. ;;;    (bintree-create '<)
  38. ;;; if the tree is going to store integers.
  39. ;;; 
  40. ;;;
  41. ;;; This package uses the macros in the file elib-node.el and
  42. ;;; a stack from stack.el.
  43. ;;;
  44.  
  45.  
  46. (require 'elib-node)
  47. (require 'stack-m)
  48.  
  49. (provide 'bintree)
  50.  
  51.  
  52. ;;; ================================================================
  53. ;;;      Internal functions for use in the binary tree package
  54.  
  55.  
  56. (defmacro elib-bintree-root (tree)
  57.  
  58.   ;; Return the root node for a binary tree.  INTERNAL USE ONLY.
  59.   (` (elib-node-left (car (cdr (, tree))))))
  60.  
  61.  
  62. (defmacro elib-bintree-dummyroot (tree)
  63.  
  64.   ;; Return the dummy node of a binary tree.  INTERNAL USE ONLY.
  65.   (` (car (cdr (, tree)))))
  66.  
  67.  
  68. (defmacro elib-bintree-cmpfun (tree)
  69.  
  70.   ;; Return the compare function of binary tree TREE.  INTERNAL USE ONLY."
  71.   (` (cdr (cdr (, tree)))))
  72.  
  73.  
  74.  
  75. (defun elib-bintree-mapc (map-function root)
  76.  
  77.   ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
  78.   ;; The function is applied in-order.
  79.   ;;
  80.   ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
  81.   ;;
  82.   ;; INTERNAL USE ONLY."
  83.  
  84.   (let ((node root)
  85.     (stack (elib-stack-create))
  86.     (go-left t))
  87.     (elib-stack-push stack nil)
  88.     (while node
  89.       (if (and go-left
  90.            (elib-node-left node))
  91.       (progn                   ; Do the left subtree first.
  92.         (elib-stack-push stack node)
  93.         (setq node (elib-node-left node)))
  94.     (funcall map-function node)           ; Apply the function...
  95.     (if (elib-node-right node)           ; and do the right subtree.
  96.         (setq node (elib-node-right node)
  97.           go-left t)
  98.       (setq node (elib-stack-pop stack)
  99.         go-left nil))))))
  100.  
  101.  
  102. (defun elib-bintree-do-copy (root)
  103.  
  104.   ;; Copy the tree with ROOT as root.  Highly recursive. INTERNAL USE ONLY.
  105.   (if (null root) 
  106.       nil
  107.     (elib-node-create (elib-bintree-do-copy (elib-node-left root))
  108.               (elib-bintree-do-copy (elib-node-right root))
  109.               (elib-node-data root))))
  110.  
  111.  
  112. ;;; ================================================================
  113. ;;;       The public functions which operate on binary trees.
  114.  
  115.  
  116. (defun bintree-create (compare-function)
  117.   "Create an empty binary tree using COMPARE-FUNCTION as the compare function.
  118. COMPARE-FUNCTION is a function which takes two arguments, A and B, and 
  119. returns non-nil if A is less than B, and nil otherwise."
  120.   
  121.   (cons 'BINTREE
  122.     (cons (elib-node-create nil nil nil)
  123.           compare-function)))
  124.  
  125.  
  126.  
  127. (defun bintree-p (obj)
  128.   "return t if OBJ is a binary tree, nil otherwise."
  129.   (eq (car-safe obj) 'BINTREE))
  130.  
  131.  
  132.  
  133. (defun bintree-compare-function (tree)
  134.   "Return the comparision function for the binary tree TREE."
  135.   (elib-bintree-cmpfun tree))
  136.  
  137.  
  138.  
  139. (defun bintree-empty (tree)
  140.   "Return t if the binary tree TREE is empty, otherwise return nil."
  141.   (null (elib-bintree-root tree)))
  142.  
  143.  
  144.  
  145. (defun bintree-enter (tree data)
  146.   "In the binary tree TREE, insert DATA."
  147.  
  148.   (let ((cmpfun (elib-bintree-cmpfun tree))
  149.     (node (elib-bintree-dummyroot tree))
  150.     (new-node (elib-node-create nil nil data)))
  151.     (if (null (elib-node-left node))
  152.     (elib-node-set-left node new-node)
  153.       (setq node (elib-node-left node))
  154.       (while node
  155.     (cond
  156.      ((funcall cmpfun data (elib-node-data node))
  157.       (if (elib-node-left node)
  158.           (setq node (elib-node-left node))
  159.         (elib-node-set-left node new-node)
  160.         (setq node nil)))
  161.  
  162.      ((funcall cmpfun (elib-node-data node) data)
  163.       (if (elib-node-right node)
  164.           (setq node (elib-node-right node))
  165.         (elib-node-set-right node new-node)
  166.         (setq node nil)))
  167.  
  168.      (t
  169.       (elib-node-set-data node data)
  170.       (setq node nil)))))))
  171.  
  172.  
  173.  
  174. (defun bintree-delete (tree data)
  175.   "From the binary tree TREE, delete DATA.
  176. Return the element in TREE which matched DATA, or nil if no element matched."
  177.  
  178.   (let* ((cmpfun (elib-bintree-cmpfun tree))
  179.      (upper-node (elib-bintree-dummyroot tree)) ; Start with the dummy node
  180.      (branch 0)                   ; Left branch
  181.      (branch-node (elib-node-left upper-node))
  182.      node-data
  183.      right-node)                   ; Only used while deleting,
  184.                            ; not while searching
  185.     (if (null branch-node)
  186.     nil
  187.       (while upper-node
  188.     (setq node-data (elib-node-data branch-node))
  189.     (cond 
  190.      ((funcall cmpfun data node-data)       ; data<node-data => go left
  191.       (setq upper-node branch-node
  192.         branch-node (elib-node-left upper-node)
  193.         branch 0))
  194.      
  195.      ((funcall cmpfun node-data data)       ; data>node-data => go right
  196.       (setq upper-node branch-node
  197.         branch-node (elib-node-right upper-node)
  198.         branch 1))
  199.      
  200.      (t                       ; This is the node we want 
  201.                            ; to delete.
  202.       (cond
  203.        ((null (elib-node-left branch-node))       ; Empty left node?
  204.         (elib-node-set-branch upper-node branch
  205.                   (elib-node-right branch-node)))
  206.        
  207.        ((null (elib-node-right branch-node))   ; Empty right node?
  208.         (elib-node-set-branch upper-node branch
  209.                   (elib-node-left branch-node)))
  210.        
  211.        (t                       ; Both branches occupied.
  212.  
  213.         ;; At this point `branch-node' points at the node we want
  214.         ;; to delete.  Both the right and the left branches are
  215.         ;; non-nil, so we will take the data of the rightmost node
  216.         ;; of the left subtree and put into `branch-node'.
  217.         (setq right-node branch-node
  218.           branch 0)
  219.         (while (elib-node-right (elib-node-branch right-node branch))
  220.           (setq right-node (elib-node-branch right-node branch)
  221.             branch 1))
  222.         (elib-node-set-data branch-node 
  223.                 (elib-node-data (elib-node-branch right-node
  224.                                   branch)))
  225.         (elib-node-set-branch right-node branch
  226.                   (elib-node-left
  227.                    (elib-node-branch right-node branch)))))
  228.       (setq upper-node nil)))))))
  229.  
  230.  
  231.  
  232. (defun bintree-member (tree data)
  233.   "Return the element in the binary tree TREE which matches DATA.
  234. Matching uses the compare function previously specified in `bintree-create'
  235. when TREE was created.
  236.  
  237. If there is no such element in the tree, the value is nil."
  238.   
  239.   (let ((node (elib-bintree-root tree))
  240.     (compare-function (elib-bintree-cmpfun tree))
  241.     found)
  242.     (while (and node 
  243.         (not found))
  244.       (cond
  245.        ((funcall compare-function data (elib-node-data node))
  246.     (setq node (elib-node-left node)))
  247.        ((funcall compare-function (elib-node-data node) data)
  248.     (setq node (elib-node-right node)))
  249.        (t 
  250.     (setq found t))))
  251.  
  252.     (if node
  253.     (elib-node-data node)
  254.       nil)))
  255.  
  256.  
  257.  
  258. (defun bintree-map (__map-function__ tree)
  259.   "Apply MAP-FUNCTION to all elements in the binary tree TREE."
  260.  
  261.   (elib-bintree-mapc
  262.    (function (lambda (node)
  263.            (elib-node-set-data node
  264.                    (funcall __map-function__
  265.                         (elib-node-data node)))))
  266.    (elib-bintree-root tree)))
  267.  
  268.  
  269.  
  270. (defun bintree-first (tree)
  271.   "Return the first element in the binary tree TREE, or nil if TREE is empty."
  272.  
  273.   (let ((node (elib-bintree-root tree)))
  274.     (if node
  275.     (progn
  276.       (while (elib-node-left node)
  277.         (setq node (elib-node-left node)))
  278.       (elib-node-data node))
  279.       nil)))
  280.  
  281.  
  282.  
  283. (defun bintree-last (tree)
  284.   "Return the last element in the binary tree TREE, or nil if TREE is empty."
  285.  
  286.   (let ((node (elib-bintree-root tree)))
  287.     (if node
  288.     (progn
  289.       (while (elib-node-right node)
  290.         (setq node (elib-node-right node)))
  291.       (elib-node-data node))
  292.       nil)))
  293.  
  294.  
  295.  
  296. (defun bintree-copy (tree)
  297.   "Return a copy of the binary tree TREE.
  298.  
  299. Note: This function is recursive and might result in an 
  300.       `max eval depth exceeded' error."
  301.  
  302.   (let ((new-tree (bintree-create 
  303.            (elib-bintree-cmpfun tree))))
  304.     (elib-node-set-left (elib-bintree-dummyroot new-tree)
  305.             (elib-bintree-do-copy (elib-bintree-root tree)))
  306.     new-tree))
  307.  
  308.   
  309.  
  310. ;;
  311. ;; Not the fastest way to do this.
  312. ;;
  313. (defun bintree-flatten (tree)
  314.   "Return a sorted list containing all elements of the binary tree TREE."
  315.  
  316.   (nreverse 
  317.    (let ((treelist nil))
  318.      (elib-bintree-mapc (function (lambda (node)
  319.                     (setq treelist (cons (elib-node-data node)
  320.                              treelist))))
  321.             (elib-bintree-root tree))
  322.      treelist)))
  323.  
  324.  
  325.  
  326. ;;
  327. ;; Not the fastest way to do this:
  328. ;;
  329. (defun bintree-size (tree)
  330.   "Return the number of elements in the binary tree TREE."
  331.  
  332.   (let ((treesize 0))
  333.     (elib-bintree-mapc (function (lambda (data)
  334.                    (setq treesize (1+ treesize))))
  335.                (elib-bintree-root tree))
  336.     treesize))
  337.  
  338.  
  339.  
  340. (defun bintree-clear (tree)
  341.   "Clear the binary tree TREE."
  342.  
  343.   (elib-node-set-left (elib-bintree-dummyroot tree) nil))
  344.